home *** CD-ROM | disk | FTP | other *** search
/ SGI Hot Mix 17 / Hot Mix 17.iso / HM17_SGI / research / external / sharelib / ftn_only_sun.f < prev    next >
Encoding:
Text File  |  1997-07-08  |  8.1 KB  |  318 lines
  1. C
  2. C    $Id: ftn_only_sun.f,v 1.2 1995/03/31 20:19:37 idl Exp $
  3. C
  4. C NAME:
  5. C     ftn_only_sun.f
  6. C
  7. C PURPOSE:
  8. C    This Fortran function is used to demonstrate how IDL can
  9. C    pass variables to a Fortran routine and then recieve these
  10. C    variables once they are modified. 
  11. C
  12. C CATEGORY:
  13. C    Dynamic Link
  14. C
  15. C CALLING SEQUENCE:
  16. C      This function is called in IDL by using the following command
  17. C      Access to this function is achived via a C 'wrapper' function.
  18. C    
  19. C      IDL> result = CALL_EXTERNAL('ftn_only.so', '_ftn_only_',    $
  20. C      IDL>      bytevar, shortvar, longvar, floatvar, doublevar,  $
  21. C      IDL>      strvar, floatarr, n_elments(floatarr) ) 
  22. C
  23. C INPUTS:
  24. C
  25. C      Byte_var:       A scalar byte variable
  26. C
  27. C      Short_var:      A scalar short integer variable
  28. C
  29. C      Long_var:       A scalar long integer variable
  30. C
  31. C      Float_var:      A scalar float variable
  32. C
  33. C      Double_var:     A scalar float variable
  34. C
  35. C      strvar:           A IDL scalar string
  36. C
  37. C      floatarr:       A floating point array
  38. C      
  39. C      cnt:           Number of elements in the array.
  40. C
  41. C OUTPUTS:
  42. C    The value of each variable is squared and the sum of the 
  43. C    array is returned as the value of the function. 
  44. C
  45. C SIDE EFFECTS:
  46. C    The values of the passed in variables are written to stdout    
  47. C
  48. C RESTRICTIONS:
  49. C    This example is setup to run using the Sun operating system. This
  50. C    does not include a system running solaris. 
  51. C
  52. C EXAMPLE:
  53. C-----------------------------------------------------------------------------
  54. C;; The following are the commands that would be used to call this
  55. C;; routine in IDL. This calls the C function that calls this FORTRAN
  56. C;; Subprogram.
  57. C;;
  58. C        byte_var        = 1b
  59. C        short_var       = 2
  60. C        long_var        = 3l
  61. C        float_var       = 4.0
  62. C        double_var      = 5d0
  63. C     floatarr     = findgen(30)*!pi
  64. C
  65. C        result = CALL_EXTERNAL('ftn_only.so', '_ftn_only_',     $
  66. C                        byte_var, short_var, long_var, float_var,      $
  67. C                        double_var, strvar, floatarr, n_elments(floatarr) )
  68. C
  69. C-----------------------------------------------------------------------------
  70. C
  71. C MODIFICATION HISTORY:
  72. C    Written October, 1993        KDB
  73. C
  74. C     Declare the Fortran function that is called by IDL via the 
  75. C    CALL_EXTERNAL Function.
  76. C
  77. C=============================================================================
  78. C$Function FTN_ONLY
  79. C
  80. C IMPORTANT NOTE:
  81. C    This function should be REAL*8 for SunOS 4.x, REAL*4 for Solaris
  82. C
  83.         REAL*4 FUNCTION FTN_ONLY(ARGC, ARGV)
  84.  
  85. C PURPOSE:
  86. C
  87. C       Example Fortran function that is called directly from IDL via
  88. C       the CALL_EXTERNAL function.
  89. C
  90. C       Declare the passed in variables
  91.  
  92.         INTEGER*4               ARGC    !Argument count
  93.         INTEGER*4               ARGV(*) !Vector of pointers to argments
  94.  
  95. C       Declare the function that will be called so that we can convert the
  96. C       IDL passed variables (ARGV) to Fortran varialbes via the parameter
  97. C       passing function %VAL().
  98.  
  99.         REAL*4                  FTN_ONLY1
  100.  
  101. C       Local variables
  102.  
  103.         INTEGER                 ARG_CNT
  104.  
  105. C       The argument count is passed in by value. Get the location of
  106. C       this value in memory (a pointer) and convert it into an
  107. C       Fortran integer.
  108.  
  109.         ARG_CNT = LOC(ARGC)
  110.  
  111. C    Insure that we got the correct number of arguments
  112.  
  113.     IF(ARG_CNT .ne. 9)THEN
  114.  
  115.        WRITE(*,*)'ftn_only: Incorrect number of arguments'
  116.        FTN_ONLY = -1.0
  117.        RETURN
  118.  
  119.     ENDIF
  120.  
  121. C       To convert the pointers to the IDL variables contained in ARGV
  122. C       we must use the Fortran function %VAL. This funcion is used
  123. C       in the argument list of a Fortran sub-program. Call the Fortran
  124. C       subroutine that will actually perform the desired operations.
  125. C       Set the return value to the value of this function.
  126.  
  127.         FTN_ONLY = FTN_ONLY1( %val(ARGV(1)), %val(ARGV(2)),
  128.      &                        %val(ARGV(3)), %val(ARGV(4)),
  129.      &                        %val(ARGV(5)), %val(ARGV(6)),
  130.      &                   %val(ARGV(7)), %val(ARGV(8)),  
  131.      &                   %val(ARGV(9)) )
  132.  
  133. C       Thats all, return to IDL.
  134.  
  135.         RETURN
  136.  
  137.         END
  138.  
  139. C=============================================================================
  140. C$Function FTN_ONLY1
  141.  
  142.           REAL*4 FUNCTION FTN_ONLY1(BYTEVAR, SHORTVAR, LONGVAR,
  143.      &        FLOATVAR, DOUBLEVAR, STRVAR,  STRLEN, FLOATARR, N)
  144.     
  145. C    Declare a parameter for the size of the temporary string
  146.  
  147.     INTEGER            CHAR_SIZE
  148.     PARAMETER    (     CHAR_SIZE     =     100  )
  149.  
  150. C       Declare an IDL string structure
  151.  
  152.     STRUCTURE /STRING/
  153.         INTEGER*2 SLEN
  154.         INTEGER*2 STYPE
  155.         INTEGER      S
  156.     END STRUCTURE
  157.  
  158.         LOGICAL*1               BYTEVAR         !IDL byte
  159.  
  160.         INTEGER*2               SHORTVAR        !IDL integer
  161.  
  162.         INTEGER*4               LONGVAR         !IDL long integer
  163.     INTEGER*4        N        !Size of array
  164.     INTEGER*4        STRLEN
  165.  
  166.         REAL*4                  FLOATVAR        !IDL float
  167.     REAL*4            FLOATARR(N)    !IDL float array
  168.     
  169.         DOUBLE PRECISION        DOUBLEVAR       !IDL double
  170.  
  171.         RECORD /STRING/        STRVAR
  172.  
  173.     INTEGER            I        !Counter
  174.     
  175.     REAL*4            SUM        
  176.  
  177.     CHARACTER*(CHAR_SIZE)    TMPSTR        !Temporary String
  178.  
  179.     CALL IDL_2_FORT(%VAL(STRVAR.S), STRVAR.SLEN, TMPSTR, CHAR_SIZE)
  180.  
  181. C    Now TMPSTR contains the IDL string in Fortran format
  182. C
  183. C       Write the values of the variables that were passed in to
  184. C       Fortran from IDL.
  185.  
  186.         WRITE(*,10)
  187.  10     FORMAT(1X,/,52('-') )
  188.  
  189.         WRITE(*,20)
  190.  20     FORMAT(1X,'Inside Fortran function ftn_only ',
  191.      &            '(Called from IDL using CALL_EXTERNAL)',/)
  192.  
  193.         WRITE(*,30)
  194.  30     FORMAT(1X,'Scalar Values Passed in From IDL:')
  195.  
  196.         WRITE(*,100)BYTEVAR
  197.  100    FORMAT(10X,'BYTE Parameter:',T50,I4)
  198.  
  199.         WRITE(*,110)SHORTVAR
  200.  110    FORMAT(10X,'SHORT Parameter:',T50,I4)
  201.  
  202.         WRITE(*,120)LONGVAR
  203.  120    FORMAT(10X,'LONG Parameter:',T50,I4)
  204.  
  205.         WRITE(*,130)FLOATVAR
  206.  130    FORMAT(10X,'FLOAT Parameter:',T50,F4.1)
  207.  
  208.         WRITE(*,140)DOUBLEVAR
  209.  140    FORMAT(10X,'Double Parameter:',T50,F4.1)
  210.  
  211.     WRITE(*,150)TMPSTR(1:STRVAR.SLEN)
  212.  150    FORMAT(10X,'String Parameter:',T50,A)
  213.  
  214.      WRITE(*,160)
  215.  160    FORMAT(10X,'Float Array:')
  216.  
  217.     WRITE(*,170)(I, FLOATARR(I), I=1, N)
  218.  170    FORMAT(15X,'Element ',I3,', Value: ',T47, F7.2)
  219.  
  220.     WRITE(*,10)     !Prints a line across the page
  221.  
  222. C       Perform a simple operation on each varable (square them).
  223.  
  224.         BYTEVAR   = BYTEVAR   * BYTEVAR
  225.         SHORTVAR  = SHORTVAR  * SHORTVAR
  226.         LONGVAR   = LONGVAR   * LONGVAR
  227.         FLOATVAR  = FLOATVAR  * FLOATVAR
  228.         DOUBLEVAR = DOUBLEVAR * DOUBLEVAR
  229.  
  230. C    Now "square" the IDL string
  231.  
  232.     TMPSTR(1:STRVAR.SLEN) = TMPSTR(1:STRVAR.SLEN/2)//
  233.      &               TMPSTR(1:STRVAR.SLEN/2)
  234.  
  235. C    Copy the string over to the IDL string
  236.  
  237.     CALL FORT_2_IDL(TMPSTR, %val(STRVAR.S), STRVAR.SLEN, CHAR_SIZE)
  238.  
  239. C     Now sum the array
  240.  
  241.     SUM = 0.0
  242.  
  243.     DO I = 1, N 
  244.  
  245.        SUM = SUM + FLOATARR(I)
  246.  
  247.     ENDDO    
  248.  
  249. C    Set the function equal to the sum
  250.  
  251.         FTN_ONLY1 = SUM 
  252.  
  253. C       Thats it, return to the calling routine
  254.  
  255.         RETURN
  256.  
  257.         END
  258.  
  259. C==========================================================================
  260. C$Subroutine IDL_2_FORT
  261.  
  262.     SUBROUTINE IDL_2_FORT(IDLSTR, STRLEN, FORTSTR, F_LEN)
  263.     
  264. C PURPOSE:
  265. C       Copies an IDL string to a Fortran character string.
  266.  
  267.     INTEGER*2        STRLEN
  268.     CHARACTER*(*)        IDLSTR
  269.     
  270.     CHARACTER*(*)        FORTSTR
  271.  
  272.         INTEGER                 F_LEN
  273.  
  274. C       If the IDL string is smaller then copy the entire string into
  275. C       the Fortran string, otherwise truncate it.
  276.  
  277.         IF(STRLEN .le. F_LEN )THEN
  278.             FORTSTR(1:STRLEN)=IDLSTR(1:STRLEN)
  279.         ELSE
  280.             FORTSTR(1:F_LEN)=IDLSTR(1:F_LEN)
  281.         ENDIF
  282.  
  283. C       Thats it
  284.  
  285.     RETURN
  286.     END
  287.  
  288. C=========================================================================
  289. C$Subroutine FORT_2_IDL
  290.  
  291.     SUBROUTINE FORT_2_IDL(FORTSTR, IDLSTR, STRLEN, F_LEN )
  292.  
  293. C PURPOSE:
  294. C    Copies a Fortran string to an IDL string
  295.  
  296.     CHARACTER*(*)    FORTSTR
  297.     CHARACTER*(*)    IDLSTR
  298.  
  299.     INTEGER*2    STRLEN
  300.  
  301.         INTEGER         F_LEN
  302.  
  303. C       If the Fortran string is smaller then copy the entire Fortran
  304. C       string into the IDL string, otherwise truncate it.
  305.  
  306.         IF(STRLEN .gt. F_LEN )THEN
  307.           IDLSTR(1:F_LEN) = FORTSTR(1:F_LEN)
  308.         ELSE
  309.           IDLSTR(1:STRLEN) = FORTSTR(1:STRLEN)
  310.         ENDIF
  311.  
  312. C    Thants it.
  313.  
  314.     RETURN
  315.  
  316.     END
  317.     
  318.